home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / exec.zip / EXEC.PAS
Pascal/Delphi Source File  |  1985-04-29  |  7KB  |  194 lines
  1. { EXEC.PAS version 1.1
  2.  
  3.   This file contains 2 functions for Turbo Pascal that allow you to run other
  4.   programs from within a Turbo program.  The first function, SubProcess,
  5.   actually calls up a different program using MS-DOS call 4BH, EXEC.  The
  6.   second function, GetComSpec, returns the path name of the command
  7.   interpreter, which is necessary to do certain operations.  There is also a
  8.   main program that allows you to test the functions.
  9.  
  10.   Version 1.1 works with DOS 2.0 and 2.1.  Version 1.0 only worked with DOS
  11.   3.0 due to a subtle bug in DOS 2.x.
  12.  
  13.     -  Bela Lubkin
  14.        Borland International Technical Support
  15.        CompuServe 71016,1573
  16. }
  17.  
  18. Type
  19.   Str66=String[66];
  20.   Str255=String[255];
  21.  
  22. Function SubProcess(CommandLine: Str255): Integer;
  23.   { Pass this function a string of the form
  24.       'D:\FULL\PATH\NAME\OF\FILE.TYP parameter1 parameter2 ...'
  25.  
  26.     For example,
  27.       'C:\SYSTEM\CHKDSK.COM'
  28.       'A:\WS.COM DOCUMENT.1'
  29.       'C:\DOS\LINK.EXE TEST;'
  30.       'C:\COMMAND.COM /C COPY *.* B:\BACKUP >FILESCOP.IED'
  31.  
  32.     The third example shows several things.  To do any of the following, you
  33.     must invoke the command processor and let it do the work: redirection;
  34.     piping; path searching; searching for the extension of a program (.COM,
  35.     .EXE, or .BAT); batch files; and internal DOS commands.  The name of the
  36.     command processor file is stored in the DOS environment.  The function
  37.     GetComSpec in this file returns the path name of the command processor.
  38.     Also note that you must use the /C parameter or COMMAND will not work
  39.     correctly.  You can also call COMMAND with no parameters.  This will allow
  40.     the user to use the DOS prompt to run anything (as long as there is enough
  41.     memory).  To get back to your program, he can type the command EXIT.
  42.  
  43.     Actual example:
  44.       I := SubProcess(GetComSpec+' /C COPY *.* B:\BACKUP >FILESCOP.IED');
  45.  
  46.     The value returned is the result returned by DOS after the EXEC call.  Theè    most common values are:
  47.  
  48.        0: Success
  49.        1: Invalid function (should never happen with this routine)
  50.        2: File/path not found
  51.        8: Not enough memory to load program
  52.       10: Bad environment (greater than 32K)
  53.       11: Illegal .EXE file format
  54.  
  55.     If you get any other result, consult an MS-DOS Technical Reference manual.
  56.  
  57.     VERY IMPORTANT NOTE: you MUST use the Options menu of Turbo Pascal to
  58.     restrict the amount of free dynamic memory used by your program.  Only the
  59.     memory that is not used by the heap is available for use by other
  60.     programs. }
  61.  
  62.   Const
  63.     SSSave: Integer=0;
  64.     SPSave: Integer=0;
  65.  
  66.   Var
  67.     Regs: Record Case Integer Of
  68.             1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: Integer);
  69.             2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  70.           End;
  71.     FCB1,FCB2: Array [0..36] Of Byte;
  72.     PathName: Str66;
  73.     CommandTail: Str255;
  74.     ParmTable: Record
  75.                  EnvSeg: Integer;
  76.                  ComLin: ^Integer;
  77.                  FCB1Pr: ^Integer;
  78.                  FCB2Pr: ^Integer;
  79.                End;
  80.  
  81.   Begin
  82.     If Pos(' ',CommandLine)=0 Then
  83.      Begin
  84.       PathName := CommandLine+#0;
  85.       CommandTail := ^M;
  86.      End
  87.     Else
  88.      Begin
  89.       PathName := Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  90.       CommandTail := Copy(CommandLine,Pos(' ',CommandLine),255)+^M;
  91.      End;
  92.     CommandTail[0] := Pred(CommandTail[0]);
  93.     With Regs Do
  94.      Begin
  95.       FillChar(FCB1,Sizeof(FCB1),0);
  96.       AX := $2901;
  97.       DS := Seg(CommandTail[1]);
  98.       SI := Ofs(CommandTail[1]);
  99.       ES := Seg(FCB1);
  100.       DI := Ofs(FCB1);è      MsDos(Regs); { Create FCB 1 }
  101.       FillChar(FCB2,Sizeof(FCB2),0);
  102.       AX := $2901;
  103.       ES := Seg(FCB2);
  104.       DI := Ofs(FCB2);
  105.       MsDos(Regs); { Create FCB 2 }
  106.       ES := CSeg;
  107.       BX := SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  108.       AH := $4A;
  109.       MsDos(Regs); { Deallocate unused memory }
  110.       With ParmTable Do
  111.        Begin
  112.         EnvSeg := MemW[CSeg:$002C];
  113.         ComLin := Addr(CommandTail);
  114.         FCB1Pr := Addr(FCB1);
  115.         FCB2Pr := Addr(FCB2);
  116.        End;
  117.       InLine($8D/$96/ PathName+1 /  { <DX> := Ofs(PathName[1]); }
  118.              $8D/$9E/ ParmTable /   { <BX> := Ofs(ParmTable);   }
  119.              $B8/$00/$4B/           { <AX> := $4B00;            }
  120.              $1E/$55/               { Save <DS>, <BP>         }
  121.              $16/$1F/               { <DS> := Seg(PathName[1]); }
  122.              $16/$07/               { <ES> := Seg(ParmTable);   }
  123.              $2E/$8C/$16/ SSSave /  { Save <SS> in SSSave     }
  124.              $2E/$89/$26/ SPSave /  { Save <SP> in SPSave     }
  125.              $FA/                   { Disable interrupts      }
  126.              $CD/$21/               { Call MS-DOS             }
  127.              $FA/                   { Disable interrupts      }
  128.              $2E/$8B/$26/ SPSave /  { Restore <SP>            }
  129.              $2E/$8E/$16/ SSSave /  { Restore <SS>            }
  130.              $FB/                   { Enable interrupts       }
  131.              $9C/$8F/$86/ Regs+18 / { Flags := <CPU flags>      }
  132.              $89/$86/ Regs+0 /      { AX := <AX>;               }
  133.              $5D/$1F);              { Restore <BP>,<DS>       }
  134.       { The messing around with SS and SP is necessary because under DOS 2.x,
  135.         after returning from an EXEC call, ALL registers are destroyed except
  136.         CS and IP!  I wish I'd known that before I released this package the
  137.         first time... }
  138.       If (Flags And 1)<>0 Then SubProcess := AX
  139.       Else SubProcess := 0;
  140.      End;
  141.   End;
  142.  
  143. Function GetComSpec: Str66;
  144.   Type
  145.     Env=Array [0..32767] Of Char;
  146.   Var
  147.     EPtr: ^Env;
  148.     EStr: Str255;
  149.     Done: Boolean;
  150.     I: Integer;
  151.  
  152.   Begin
  153.     EPtr := Ptr(MemW[CSeg:$002C],0);
  154.     I := 0;è    Done := False;
  155.     EStr := '';
  156.     Repeat
  157.       If EPtr^[I]=#0 Then
  158.        Begin
  159.         If EPtr^[I+1]=#0 Then Done := True;
  160.         If Copy(EStr,1,8)='COMSPEC=' Then
  161.          Begin
  162.           GetComSpec := Copy(EStr,9,100);
  163.           Done := True;
  164.          End;
  165.         EStr := '';
  166.        End
  167.       Else EStr := EStr+EPtr^[I];
  168.       I := I+1;
  169.     Until Done;
  170.   End;
  171.  
  172. { Example program.  Set both mInimum and mAximum free dynamic memory to 100
  173.   and compile this to a .COM file.  Delete the next line to enable: }
  174. (*
  175.  
  176. Var Command: Str255;
  177.     I: Integer;
  178.  
  179. Begin
  180.   WriteLn('Enter a * to quit; put a * before a command to use COMMAND.COM.');
  181.   Repeat
  182.     Write('=->');
  183.     ReadLn(Command);
  184.     If Command='*' Then Halt;
  185.     If Command<>'' Then
  186.      Begin
  187.       If Command[1]='*' Then Command := GetComSpec+' /C '+Copy(Command,2,255);
  188.       I := SubProcess(Command);
  189.       If I<>0 Then WriteLn('Error - ',I);
  190.      End;
  191.   Until False;
  192. End.
  193. *)
  194.